GroundwaterParameterUpdate Subroutine

private subroutine GroundwaterParameterUpdate(time)

update boundary condition map that change in time

Arguments

Type IntentOptional Attributes Name
type(DateTime), intent(in) :: time

Variables

Type Visibility Attributes Name Initial
character(len=300), public :: filename
integer(kind=short), public :: i
integer(kind=short), public :: j
integer(kind=short), public :: k
character(len=300), public :: varname

Source Code

SUBROUTINE GroundwaterParameterUpdate   & 
  !
  (time)       

IMPLICIT NONE

!Arguments with intent(in):
TYPE (DateTime), INTENT (IN) :: time

!local declarations:
CHARACTER (LEN = 300) :: filename
CHARACTER (LEN = 300) :: varname
INTEGER (KIND = short) :: k, i, j

!------------------------------end of declarations-----------------------------
  
  
  
!boundary condition
DO k = 1, basin % naquifers
    IF (  time == basin % aquifer (k) % valueBC % next_time ) THEN
       !destroy current grid
       filename = basin % aquifer (k) % valueBC % file_name
       varname = basin % aquifer (k) % valueBC % var_name
       CALL GridDestroy (basin % aquifer (k) % valueBC )
       !read new grid in netcdf file
       CALL NewGrid (basin % aquifer (k) % valueBC, TRIM(filename), NET_CDF, &
                      variable = TRIM(varname), time = time)
       
       !head boundary condition overlay
        DO i = 1, basin % aquifer (k) % domainBC % idim
            DO j = 1, basin % aquifer (k) % domainBC % jdim
                IF ( basin % aquifer (k) % domainBC % mat (i,j) == &
                    BC_DIRICHLET ) THEN
            
                    basin % aquifer (k) % head0 % mat (i,j) = &
                    basin % aquifer (k) % valueBC % mat (i,j)
                     
                    basin % aquifer (k) % head1 % mat (i,j) = &
                    basin % aquifer (k) % valueBC % mat (i,j)
               END IF
            END DO
        END DO
    END IF
END DO
  
RETURN
END SUBROUTINE GroundwaterParameterUpdate